            
{ Copyright (C) 2009, Serge Voloshenyuk
  
  This file is Free Software and part of DCocoR
  
  It is licensed under the following three licenses as alternatives:
    1. GNU Lesser General Public License (LGPL) V2.1 or any newer version
    2. GNU General Public License (GPL) V2 or any newer version
    3. Apache License, V2.0 or any newer version
  
  You may not use this file except in compliance with at least one of
  the above three licenses.
  
  See LICENSE.txt at the top of this package for the
  complete terms and further detail along with the license texts for
  the licenses in COPYING-LIB.txt, COPYING.txt and LICENSE-2.0.txt respectively.
} 

{ This unit was generated by DCocoR.  
  Any code in this file that you edit manually will be over-written when the file is regenerated.
}

unit Coco;

interface

uses Classes,CocoAncestor,CocoGenerator,
SysUtils,CharSets, CRTypes, CRT, CRA;

type


  TCocoScanner = class(TCocoRScanner)
  public
    procedure SkipIgnoreSet; override;
    procedure ScanSym(state: Integer; var sym: Integer); override;
    function SkipComments(ind: Integer): Boolean; override;
  end;


  TCoco = class(TCocoGenerator)
  private              
    tokenString: String;
    SkipWarnSuppression: Boolean;
 
  protected

    procedure _Coco;
    procedure _TemplateVar;
    procedure _SetDecl;
    procedure _TokenDecl(typ: TSymbolType);
    procedure _HomographString;
    procedure _CommentDecl;
    procedure _Set(var cset: TCharSet);
    procedure _Production;
    procedure _SimSet(var cset: TCharSet);
    procedure _SingleChar(var n: Integer);
    procedure _Sym(var name: String; var isID: Boolean);
    procedure _TokenExpr(var nL1,nR1: TNode);
    procedure _SemText(pos: PSymbol);
    procedure _TokenTerm(var nL1,nR1: TNode);
    procedure _TokenFactor(var nL,nR: TNode);
    procedure _Attribs(pos: PSymbol);
    procedure _Expression(var nL1,nR1: TNode);
    procedure _Term(var nL1,nR1: TNode);
    procedure _Factor(var nL,nR: TNode);

  public
            
    tab: TSymbolTable;
    dfa: TAutomaton;
    genScanner: Boolean;


    procedure ProcessPragmas; override;
    function  ErrorMessage(ErrorType,ErrorCode: Integer; const data: string): String; override;
    function  TokenToString(n: Integer): String; override;
    function  CreateScanner: TBaseScanner; override;
    function Execute: Boolean; override;

    constructor Create(AOwner: TComponent); override;

  end;

implementation

const

	identSym = 1;	stringSym = 2;	badstringSym = 3;	numberSym = 4;	COMPILERSym = 5;
	FRAMESym = 6;	ENDSym = 7;	CHARACTERSSym = 8;	TOKENSSym = 9;	HOMOGRAPHSSym = 10;
	PRAGMASSym = 11;	COMMENTSSym = 12;	IGNORECASESym = 13;	IGNORESym = 14;	PRODUCTIONSSym = 15;
	_pointSym = 16;	_equalSym = 17;	_plusSym = 18;	_minusSym = 19;	_point_pointSym = 20;
	ANYSym = 21;	CHRSym = 22;	_lparenSym = 23;	_rparenSym = 24;	HOMOGRAPHSym = 25;
	_barSym = 26;	CONTEXTSym = 27;	_lbrackSym = 28;	_rbrackSym = 29;	_lbraceSym = 30;
	_rbraceSym = 31;	FROMSym = 32;	TOSym = 33;	NESTEDSym = 34;	_lessSym = 35;
	_greaterSym = 36;	_lparen_pointSym = 37;	_point_rparenSym = 38;	IFSym = 39;	WEAKSym = 40;
	SYNCSym = 41;	_NOSYMB = 42;	_slash_starSym = 43;	WarnPragmaSym = 44;	IGnoreWarnPragmaSym = 45;


var CocoSymSets: TSetArray;


var
  CocoST: TStartTable = nil;
  CocoLiterals: TStringList = nil;

{ TCocoScanner }

procedure TCocoScanner.ScanSym(state: Integer; var sym: Integer);
begin
 while True do
 begin
  NextCh;
  case state of
	 1:
		if ((CurrInputCh>='0')and(CurrInputCh<='9'))or((CurrInputCh>='A')and(CurrInputCh<='Z'))or(CurrInputCh='_')or((CurrInputCh>='a')and(CurrInputCh<='z')) then
		else begin
		  sym := identSym;
		  CheckLiteral(sym);
		  Exit;
		end;
	 2:
		begin
		  sym := stringSym;
		  Exit;
		end;
	 3:
		begin
		  sym := badstringSym;
		  Exit;
		end;
	 4:
		if ((CurrInputCh>='0')and(CurrInputCh<='9')) then
		else begin
		  sym := numberSym;
		  Exit;
		end;
	 5:
		if (CurrInputCh = '*') then
		  state := 6
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	 6:
		begin
		  sym := _slash_starSym;
		  Exit;
		end;
	 7:
		if (CurrInputCh = '}') then
		  state := 8
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	 8:
		begin
		  sym := WarnPragmaSym;
		  Exit;
		end;
	 9:
		if (CurrInputCh = '}') then
		  state := 10
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	10:
		begin
		  sym := IGnoreWarnPragmaSym;
		  Exit;
		end;
	11:
		if not(((CurrInputCh>=#1)and(CurrInputCh<=#31))or(CurrInputCh='"')) then
		else if (CurrInputCh=#10)or(CurrInputCh=#13) then
		  state := 3
		else if (CurrInputCh = '"') then
		  state := 2
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	12:
		if not(((CurrInputCh>=#1)and(CurrInputCh<=#31))or(CurrInputCh='''')) then
		else if (CurrInputCh=#10)or(CurrInputCh=#13) then
		  state := 3
		else if (CurrInputCh = '''') then
		  state := 2
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	13:
		if (CurrInputCh = '+') then
		  state := 14
		else if (CurrInputCh = '-') then
		  state := 7
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	14:
		if (CurrInputCh = '}') then
		  state := 8
		else if (CurrInputCh = '+') then
		  state := 9
		else begin
		  sym := _NOSYMB;
		  Exit;
		end;
	15:
		begin
		  sym := _equalSym;
		  Exit;
		end;
	16:
		begin
		  sym := _plusSym;
		  Exit;
		end;
	17:
		begin
		  sym := _minusSym;
		  Exit;
		end;
	18:
		begin
		  sym := _point_pointSym;
		  Exit;
		end;
	19:
		begin
		  sym := _rparenSym;
		  Exit;
		end;
	20:
		begin
		  sym := _barSym;
		  Exit;
		end;
	21:
		begin
		  sym := _lbrackSym;
		  Exit;
		end;
	22:
		begin
		  sym := _rbrackSym;
		  Exit;
		end;
	23:
		begin
		  sym := _rbraceSym;
		  Exit;
		end;
	24:
		begin
		  sym := _lessSym;
		  Exit;
		end;
	25:
		begin
		  sym := _greaterSym;
		  Exit;
		end;
	26:
		begin
		  sym := _lparen_pointSym;
		  Exit;
		end;
	27:
		begin
		  sym := _point_rparenSym;
		  Exit;
		end;
	28:
		if (CurrInputCh = 'W') then
		  state := 13
		else begin
		  sym := _lbraceSym;
		  Exit;
		end;
	29:
		if (CurrInputCh = '.') then
		  state := 18
		else if (CurrInputCh = ')') then
		  state := 27
		else begin
		  sym := _pointSym;
		  Exit;
		end;
	30:
		if (CurrInputCh = '.') then
		  state := 26
		else begin
		  sym := _lparenSym;
		  Exit;
		end;
  
    else begin
      if CurrInputCh=#0 then
           sym := _EOFSYMB
      else sym := _NOSYMB;
      Exit;
    end;
  end;
 end;
end;


procedure TCocoScanner.SkipIgnoreSet;
begin
  while (CurrInputCh = ' ') or 
    ( (CurrInputCh=#9)or(CurrInputCh=#10)or(CurrInputCh=#13) )
  do NextCh;
end;


function TCocoScanner.SkipComments(ind: Integer): Boolean;
begin
  Result := True;
  case ind of
    _slash_starSym: SkipNestedComment(#39'/*'#39,'*/');

    else Result := False;
  end;
end;



{ TCoco }


procedure TCoco._Coco;
                                   var gramName : String; 
begin
                                   SkipWarnSuppression := False; 
  Expect(COMPILERSym);
                                   genScanner := True;  
  Expect(identSym);
                                   gramName := LexName; 
  if (CurrentInputSymbol=FRAMESym) then
  begin
    Get;
    if (CurrentInputSymbol=stringSym) then
    begin
      Get;
                                   tab.FrameName := LexString; 
    end;
    while (CurrentInputSymbol=identSym) do
    begin
      _TemplateVar;
    end;
    ExpectWeak(ENDSym,0);
  end;
  while InSet(CurrentInputSymbol,1) do
  begin
    while not InSet(CurrentInputSymbol,2) do
    begin SynError(1); Get; end;
    if (CurrentInputSymbol=CHARACTERSSym) then
    begin
         Get;
         while (CurrentInputSymbol=identSym) do
         begin
           _SetDecl;
         end;
    end
    else if (CurrentInputSymbol=TOKENSSym) then
    begin
         Get;
         while (CurrentInputSymbol in [identSym, stringSym]) do
         begin
           _TokenDecl(stTerminal);
         end;
    end
    else if (CurrentInputSymbol=HOMOGRAPHSSym) then
    begin
         Get;
         while (CurrentInputSymbol=stringSym) do
         begin
           _HomographString;
         end;
    end
    else if (CurrentInputSymbol=PRAGMASSym) then
    begin
         Get;
         while (CurrentInputSymbol in [identSym, stringSym]) do
         begin
           _TokenDecl(stPragma);
         end;
    end
    else if (CurrentInputSymbol=COMMENTSSym) then
    begin
         Get;
         _CommentDecl;
    end
    else if (CurrentInputSymbol=IGNORECASESym) then
    begin
         Get;
                                   tab.ignoreCase := True; 
    end
    else if (CurrentInputSymbol=IGNORESym) then
    begin
         Get;
         _Set(tab.IgnoredChars);
    end
    ;
  end;
  while not (CurrentInputSymbol in [_EOFSYMB, PRODUCTIONSSym]) do
  begin SynError(1); Get; end;
  Expect(PRODUCTIONSSym);
                                   if genScanner then dfa.MakeDeterministic;
                                   tab.DeleteNodes;
                                
  while (CurrentInputSymbol=identSym) do
  begin
    _Production;
  end;
  Expect(ENDSym);
  Expect(identSym);
                                   if gramName <> LexName then
                                     SemError(209);
                                   tab.gramSy := TNtSymbol(tab.Symbols[gramName]);
                                   if tab.gramSy = nil then
                                     SemError(210)
                                   else if tab.gramSy.hasAttrPos then
                                       SemError(211);
                                   tab.Finalize;
                                 
  Expect(_pointSym);
end;

procedure TCoco._TemplateVar;
               var name: String; pos: TSymbolRec; 
begin
  Expect(identSym);
                             name := LexName; 
  Expect(_equalSym);
  _SemText(@pos);
                             tab.TemplateVars[name] := @pos; 
end;

procedure TCoco._SetDecl;
                                   var name: String; c: Integer; cset: TCharSet; 
begin
  Expect(identSym);
                                   name := LexName; cset := nil;
                                   c := tab.CharClassByName[name];
                                   if c>=0 then SemError(212);
                                 
  Expect(_equalSym);
  _Set(cset);
                                   if cset.IsEmpty then SemError(213);
                                   tab.NewCharClass(name, cset);
                                 
  Expect(_pointSym);
end;

procedure TCoco._TokenDecl(typ: TSymbolType);
 var name: String; isID: Boolean; sym: TSymbol; nL,nR: TNode; 

   procedure ProcLiteral(const lit: String);
   begin
     if tab.literals[lit] <> nil then
       SemError(218);
     tab.literals[lit] := sym;
     dfa.MatchLiteral(lit, sym);
   end;

begin
  _Sym(name, isID);
                                   sym := tab.Symbols[name];
                                   if sym<>nil then SemError(212)
                                   else begin
                                     sym := tab.NewSym(typ, name, CurLine);
                                     sym.kind := tkFixed;
                                   end;
                                   tokenString := '';
                                 
  while not InSet(CurrentInputSymbol,0) do
  begin SynError(2); Get; end;
  if (CurrentInputSymbol=_equalSym) then
  begin
       Get;
       if InSet(CurrentInputSymbol,3) then
       begin
            _TokenExpr(nL,nR);
                                   if not isID then SemError(217);
                                   nR.FinishGraph;
                                   if (tokenString='')or(tokenString='-none-') then
                                     dfa.ConvertToStates(nL, sym)
                                   else ProcLiteral(tokenString);
                                 
       end
       else if (CurrentInputSymbol=HOMOGRAPHSym) then
       begin
            Get;
            Expect(stringSym);
                                   if not isID then SemError(217);
                                   ProcLiteral(LexName);
                                   TtSymbol(sym).homograph := True;
                                 
       end
       else SynError(3);
       Expect(_pointSym);
  end
  else if InSet(CurrentInputSymbol,4) then
  begin
                                   if isID then genScanner := false
                                   else dfa.MatchLiteral(sym.name, sym);
                                 
  end
  else SynError(3);
  if (CurrentInputSymbol=_lparen_pointSym) then
  begin
    _SemText(sym.semPos);
                                   if typ<>stPragma then SemError(219); 
  end;
end;

procedure TCoco._HomographString;
 var name: String; sym: TSymbol; 
begin
  Expect(stringSym);
                                   name := tab.FixStringForToken(LexName);
                                   sym := tab.Symbols[name];
                                   if sym<>nil then SemError(212)
                                   else begin
                                     sym := tab.NewSym(stTerminal, name, CurLine);
                                     sym.kind := tkFixed;
                                   end;
                                   if tab.literals[name] <> nil then
                                     SemError(218);
                                   tab.literals[name] := sym;
                                   dfa.MatchLiteral(name, sym);
                                   TtSymbol(sym).homograph := True;
                                 
end;

procedure TCoco._CommentDecl;
                                  var nested: Boolean; nL1,nR1,nL2,nR2: TNode; 
begin
                                  nested := False; 
  Expect(FROMSym);
  _TokenExpr(nL1,nR1);
  Expect(TOSym);
  _TokenExpr(nL2,nR2);
  if (CurrentInputSymbol=NESTEDSym) then
  begin
    Get;
                                  nested := True; 
  end;
                                  dfa.NewComment(nL1, nL2, nested); 
end;

procedure TCoco._Set(var cset: TCharSet);
                                  var cset2: TCharSet;  
begin
                                   cset2 := nil;
                                   try
                                 
  _SimSet(cset);
  while (CurrentInputSymbol in [_plusSym, _minusSym]) do
  begin
    if (CurrentInputSymbol=_plusSym) then
    begin
         Get;
         _SimSet(cset2);
                                   cset.Unite(cset2);  
    end
    else if (CurrentInputSymbol=_minusSym) then
    begin
         Get;
         _SimSet(cset2);
                                   cset.Subtract(cset2); 
    end
    ;
  end;
                                   finally cset2.Free; end; 
end;

procedure TCoco._Production;
                                  var sym: TSymbol;
                                  nR: TNode;
                                  undef: Boolean;
                                  pos: TSymbolRec;
                                
begin
  Expect(identSym);
                                  sym := tab.Symbols[LexName];
                                  undef := sym = nil;
                                  if undef then
                                     sym := tab.NewSym(stNonterminal, LexName, CurLine)
                                  else begin
                                     if sym.typ = stNonterminal then
                                     begin
                                       if sym.graph <> nil then SemError(212); 
                                     end else SemError(221);
                                     sym.line := CurLine;
                                  end;
                                  ClearSymbol(@pos);
                                
  if (CurrentInputSymbol=_lessSym) then
  begin
    _Attribs(@pos);
  end;
                                  if (not undef)and((pos.Beg<>-1)<>sym.hasAttrPos)  then
                                     SemError(222);
                                  if pos.Beg<>-1 then sym.AttrPos^ := pos;
                                
  if (CurrentInputSymbol=_lparen_pointSym) then
  begin
    _SemText(sym.semPos);
  end;
  ExpectWeak(_equalSym,5);
  _Expression(TNtSymbol(sym).fGraph,nR);
                                              nR.FinishGraph; 
  ExpectWeak(_pointSym,6);
end;

procedure TCoco._SimSet(var cset: TCharSet);
                                   var n1, n2: Integer; 
begin
                                   if cset=nil then cset := TCharSet.Create
                                   else cset.Clear;
                                 
  if (CurrentInputSymbol=identSym) then
  begin
       Get;
                                   n1 := tab.CharClassByName[LexName];
                                   if n1<0 then SemError(214)
                                   else cset.Unite(tab.CharClassSet[n1]);
                                
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                   FillSetByStr(cset,DequotedStr(LexString));  
  end
  else if (CurrentInputSymbol=CHRSym) then
  begin
       _SingleChar(n1);
                                   if n1>=0 then cset.AddChar(n1); 
       if (CurrentInputSymbol=_point_pointSym) then
       begin
         Get;
         _SingleChar(n2);
                                   cset.AddRange(n1,n2);    
       end;
  end
  else if (CurrentInputSymbol=ANYSym) then
  begin
       Get;
                                   cset.Fill; 
  end
  else SynError(4);
end;

procedure TCoco._SingleChar(var n: Integer);
                                   var s: String; 
begin
  Expect(CHRSym);
  Expect(_lparenSym);
  if (CurrentInputSymbol=numberSym) then
  begin
       Get;
                                  
                                   n := StrToIntDef(LexString,-1);
                                   if n<0 then
                                     SemError(215)
                                   else if n > 127 then
                                   begin
                                     SemError(215); n := -1;
                                   end;
                                 
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                   s := LexString;
                                    if Length(s)<>3 then SemError(216);
                                    n := Ord(s[2]);
                                 
  end
  else SynError(5);
  Expect(_rparenSym);
end;

procedure TCoco._Sym(var name: String; var isID: Boolean);
begin
  if (CurrentInputSymbol=identSym) then
  begin
       Get;
                                  isID := True; name := LexName; 
  end
  else if (CurrentInputSymbol=stringSym) then
  begin
       Get;
                                  isId := False; name := tab.FixStringForToken(LexName); 
  end
  else SynError(6);
end;

procedure TCoco._TokenExpr(var nL1,nR1: TNode);
                                   var nL2,nR2: TNode; first: Boolean; 
begin
  _TokenTerm(nL1,nR1);
                                   first := True; 
  while WeakSeparator(26,3,7) do
  begin
    _TokenTerm(nL2,nR2);
                                   if first then
                                   begin
                                     tab.MakeFirstAlt(nL1,nR1); first := false;
                                   end;
                                   tab.MakeAlt(nL1,nR1,nL2,nR2);
                                 
  end;
end;

procedure TCoco._SemText(pos: PSymbol);
begin
  Expect(_lparen_pointSym);
                                    pos^ := CurSymbol^; 
  while InSet(CurrentInputSymbol,8) do
  begin
    if InSet(CurrentInputSymbol,9) then
    begin
         Get;
    end
    else if (CurrentInputSymbol=badstringSym) then
    begin
         Get;
                                    SemError(224); 
    end
    else if (CurrentInputSymbol=_lparen_pointSym) then
    begin
         Get;
                                    SemError(225); 
    end
    ;
  end;
  Expect(_point_rparenSym);
                                    Inc(pos^.Beg,2);
                                    pos^.Len := CurSymbol^.Beg - pos^.Beg;
                                  
end;

procedure TCoco._TokenTerm(var nL1,nR1: TNode);
                                  var nL2,nR2: TNode; 
begin
  _TokenFactor(nL1,nR1);
  while InSet(CurrentInputSymbol,3) do
  begin
    _TokenFactor(nL2,nR2);
                                  tab.MakeSeq(nL1,nR1,nL2,nR2); 
  end;
  if (CurrentInputSymbol=CONTEXTSym) then
  begin
    Get;
    Expect(_lparenSym);
    _TokenExpr(nL2,nR2);
                                  tab.SetContextTrans(nL2);
                                  dfa.hasCtxMoves := True;
                                  tab.MakeSeq(nL1,nR1,nL2,nR2);
                                
    Expect(_rparenSym);
  end;
end;

procedure TCoco._TokenFactor(var nL,nR: TNode);
                                  var name: String; isID: Boolean; c: Integer; 
begin
                                  nL := nil; nR := nil; 
  if (CurrentInputSymbol in [identSym, stringSym]) then
  begin
       _Sym(name, isID);
                                  if isID then begin
                                    c := tab.CharClassByName[name];
                                    if c<0 then begin
                                       SemError(220);
                                       c := tab.NewCharClass(name);
                                    end;
                                    nL := tab.NewNode(ntCharClass,nil,CurLine); nL.val := c;
                                    nR := nL;
                                    tokenString := '-none-';
                                  end else begin // str
                                     tab.StrToGraph(name,nL,nR);
                                     if tokenString='' then
                                      tokenString := name
                                     else tokenString := '-none-';
                                 end;
                                 
  end
  else if (CurrentInputSymbol=_lparenSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rparenSym);
  end
  else if (CurrentInputSymbol=_lbrackSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rbrackSym);
                                  tab.MakeOpt(nL,nR);  
  end
  else if (CurrentInputSymbol=_lbraceSym) then
  begin
       Get;
       _TokenExpr(nL,nR);
       Expect(_rbraceSym);
                                  tab.MakeIter(nL,nR); 
  end
  else SynError(7);
                                  if nL=nil then // invalid start of TokenFactor
                                  begin nL := tab.NewNode(ntEps, nil, 0); nR := nL; end; 
end;

procedure TCoco._Attribs(pos: PSymbol);
                                  var start: TSymbolRec; 
begin
  Expect(_lessSym);
                                  start := NextSymbol^; 
  while InSet(CurrentInputSymbol,10) do
  begin
    if InSet(CurrentInputSymbol,11) then
    begin
         Get;
    end
    else if (CurrentInputSymbol=badstringSym) then
    begin
         Get;
                                  SemError(223); 
    end
    ;
  end;
  Expect(_greaterSym);
                                  with CurSymbol^ do
                                  if start.Beg <> Beg then
                                  begin
                                    start.Len := Beg - start.Beg;
                                    pos^ := start;
                                  end;
                                
end;

procedure TCoco._Expression(var nL1,nR1: TNode);
                                     var nL2,nR2: TNode; first: Boolean; 
begin
  _Term(nL1,nR1);
                                   first := True; 
  while WeakSeparator(26,12,13) do
  begin
    _Term(nL2,nR2);
                                   if first then
                                   begin
                                     tab.MakeFirstAlt(nL1, nR1);
                                     first := False;
                                   end;
                                   tab.MakeAlt(nL1,nR1,nL2,nR2);
                                 
  end;
end;

procedure TCoco._Term(var nL1,nR1: TNode);
                                   var nL2, nR2: TNode; 
begin
                                   nL1 := nil; nR1 := nil; 
  if InSet(CurrentInputSymbol,14) then
  begin
       if (CurrentInputSymbol=IFSym) then
       begin
         Get;
                                   nL1 := tab.NewNode(ntIf,nil, CurLine); nR1 := nL1; 
         _SemText(@nL1.pos);
       end;
       _Factor(nL2,nR2);
                                   if nL1<>nil then tab.MakeSeq(nL1,nR1,nL2,nR2)
                                   else begin nL1 := nL2; nR1 := nR2; end;
                                 
       while InSet(CurrentInputSymbol,15) do
       begin
         _Factor(nL2,nR2);
                                   tab.MakeSeq(nL1, nR1, nL2, nR2); 
       end;
  end
  else if InSet(CurrentInputSymbol,16) then
  begin
                                   nL1 := tab.NewNode(ntEps, nil, CurLine); nR1 := nL1; 
  end
  else SynError(8);
                                   if nL1=nil then //invalid start of Term
                                   begin nL1 := tab.NewNode(ntEps, nil, 0); nR1 := nL1; end; 
end;

procedure TCoco._Factor(var nL,nR: TNode);
                                 var name: String; isID, weak, undef: Boolean;
                                 sym: TSymbol; typ: TNodeType;
                                 pos: TSymbolRec;
                               
begin
                                 weak := False; nL := nil; nR := nil; 
  if (CurrentInputSymbol in [identSym, stringSym, WEAKSym]) then
  begin
       if (CurrentInputSymbol=WEAKSym) then
       begin
         Get;
                                 weak := True; 
       end;
       _Sym(name, isID);
                                 sym := tab.Symbols[name];
                                 if (sym=nil)and not IsID then
                                     sym := tab.Literals[name]; 
                                 undef := sym=nil;
                                 if undef then
                                    if isID  then
                                       sym := tab.NewSym(stNonterminal, name, 0)
                                    else if genScanner then
                                    begin
                                       sym := tab.NewSym(stTerminal, name, CurLine);
                                       dfa.MatchLiteral(sym.name, sym);
                                    end else begin  // undefined string in production
                                       SemError(226);
                                       sym := tab.eofSy;  // dummy
                                    end;

                                 typ := NodeTypeForSymType(sym.typ);
                                 if typ=ntUnknown then
                                     SemError(227);
                                 if weak then
                                   if typ=ntTerminal then typ := ntWeakTerminal
                                 else SemError(228);
                                 nL := tab.NewNode(typ, sym, CurLine);
                                 nR := nL;
                                 ClearSymbol(@pos);
                               
       if (CurrentInputSymbol=_lessSym) then
       begin
         _Attribs(@pos);
                                 if not isID then SemError(229); 
       end;
                                 if (not undef)and((pos.Beg<>-1)<>sym.hasAttrPos)  then
                                   SemError(222);
                                 nL.pos := pos;
                                 if undef and (pos.Beg<>-1) then sym.attrPos^ := pos;
                               
  end
  else if (CurrentInputSymbol=_lparenSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rparenSym);
  end
  else if (CurrentInputSymbol=_lbrackSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rbrackSym);
                                  tab.MakeOpt(nL,nR);  
  end
  else if (CurrentInputSymbol=_lbraceSym) then
  begin
       Get;
       _Expression(nL,nR);
       Expect(_rbraceSym);
                                  tab.MakeIter(nL,nR); 
  end
  else if (CurrentInputSymbol=_lparen_pointSym) then
  begin
       _SemText(@pos);
                                  nL := tab.NewNode(ntSem,nil,CurLine); nR := nL;
                                 nL.pos := pos;
                               
  end
  else if (CurrentInputSymbol=ANYSym) then
  begin
       Get;
                                  nL := tab.NewNode(ntAny,nil,CurLine);  // p.set is set in tab.SetupAnys
                                  nR := nL;
                               
  end
  else if (CurrentInputSymbol=SYNCSym) then
  begin
       Get;
                                  nL := tab.NewNode(ntSync,nil, CurLine); nR := nL; 
  end
  else SynError(9);
end;



function TCoco.TokenToString(n: Integer): String;
const TokenStrings: array[0.._NOSYMB] of String = ('EOF'
	,'ident'	,'string'	,'badstring'	,'number'	,'"COMPILER"'
	,'"FRAME"'	,'"END"'	,'"CHARACTERS"'	,'"TOKENS"'	,'"HOMOGRAPHS"'
	,'"PRAGMAS"'	,'"COMMENTS"'	,'"IGNORECASE"'	,'"IGNORE"'	,'"PRODUCTIONS"'
	,'"."'	,'"="'	,'"+"'	,'"-"'	,'".."'
	,'"ANY"'	,'"CHR"'	,'"("'	,'")"'	,'"HOMOGRAPH"'
	,'"|"'	,'"CONTEXT"'	,'"["'	,'"]"'	,'"{"'
	,'"}"'	,'"FROM"'	,'"TO"'	,'"NESTED"'	,'"<"'
	,'">"'	,'"(."'	,'".)"'	,'"IF"'	,'"WEAK"'
	,'"SYNC"'  ,'not');
begin
  if n in [0.._NOSYMB] then
    Result := TokenStrings[n]
  else Result := '?';
end;

function TCoco.ErrorMessage(ErrorType, ErrorCode: Integer; const data: string): String;
begin
  case ErrorCode of
	1 : Result := 'this symbol not expected in Coco';
	2 : Result := 'this symbol not expected in TokenDecl';
	3 : Result := 'invalid TokenDecl';
	4 : Result := 'invalid SimSet';
	5 : Result := 'invalid SingleChar';
	6 : Result := 'invalid Sym';
	7 : Result := 'invalid TokenFactor';
	8 : Result := 'invalid Term';
	9 : Result := 'invalid Factor';

               
  200: Result := 'empty token not allowed';
  201: Result := Format('Template var "%s" declared twice',[data]);
  202: Result := 'empty token not allowed';
  203: Result := 'literal tokens must not contain blanks';
  204: Result := 'token might be empty';
  205: Result := Format('tokens %s cannot be distinguished',[data]);
  206: Result := 'character set contains more than 1 character';
  207: Result := 'comment delimiters may not be structured';
  208: Result := 'comment delimiters must be 1 or 2 characters long';
  209: Result := 'name does not match grammar name';
  210: Result := 'missing production for grammar name';
  211: Result := 'grammar symbol must not have attributes';
  212: Result := 'name declared twice';
  213: Result := 'character set must not be empty';
  214: Result := 'undefined name';
  215: Result := 'must be integer number <=127';
  216: Result := 'char = string[1]';
  217: Result := 'a literal must not be declared with a structure';
  218: Result := 'token string declared twice';
  219: Result := 'semantic action not allowed here';
  220: Result := 'undefined name';
  221: Result := 'this symbol kind not allowed on left side of production';
  222: Result := 'attribute mismatch between declaration and use of this symbol';
  223: Result := 'bad string in attributes';
  224: Result := 'bad string in semantic action';
  225: Result := 'missing end of previous semantic action';
  226: Result := 'undefined string in production';
  227: Result := 'this symbol kind is not allowed in a production';
  228: Result := 'only terminals may be weak';
  229: Result := 'a literal must not have attributes';
  230: Result := 'only literal could be homograph';
 
    else Result := inherited ErrorMessage(ErrorType, ErrorCode,data);
  end;
end;


procedure TCoco.ProcessPragmas;
begin
  case CurrentInputSymbol of
    WarnPragmaSym:
	begin
          if not SkipWarnSuppression then tab.WarnSuppression := LexStrings[1][3]='-'; 
	end;
    IGnoreWarnPragmaSym:
	begin
          SkipWarnSuppression := True; tab.WarnSuppression := False; 
	end;
  end;

end;


function TCoco.Execute: Boolean;
begin
  Reinit;
  _Coco;
  Result := Successful;
end;


function TCoco.CreateScanner: TBaseScanner;
begin
  Result := TCocoScanner.Create(Self);
  if CocoST=nil then
  begin
    CocoST := TStartTable.Create;
    with CocoST do
    begin
	  FillRange(65, 90, 1);  States[95] := 1;  FillRange(97, 122, 1);  FillRange(48, 57, 4);
	  States[34] := 11;  States[39] := 12;  States[47] := 5;  States[123] := 28;  States[46] := 29;
	  States[61] := 15;  States[43] := 16;  States[45] := 17;  States[40] := 30;  States[41] := 19;
	  States[124] := 20;  States[91] := 21;  States[93] := 22;  States[125] := 23;  States[60] := 24;
	  States[62] := 25;
    end;
    CocoLiterals := CreateLiterals(True,
	['COMPILER','FRAME','END','CHARACTERS','TOKENS','HOMOGRAPHS','PRAGMAS','COMMENTS','IGNORECASE','IGNORE','PRODUCTIONS'
		,'ANY','CHR','HOMOGRAPH','CONTEXT','FROM','TO','NESTED','IF','WEAK','SYNC'],
	[COMPILERSym,FRAMESym,ENDSym,CHARACTERSSym,TOKENSSym,HOMOGRAPHSSym,PRAGMASSym,COMMENTSSym,IGNORECASESym,IGNORESym
		,PRODUCTIONSSym,ANYSym,CHRSym,HOMOGRAPHSym,CONTEXTSym,FROMSym,TOSym,NESTEDSym,IFSym,WEAKSym,SYNCSym]
     );
  end;
  with TCocoScanner(Result) do
  begin
      
    noSym := _NOSYMB;
    StartState := CocoST;
    Literals := CocoLiterals;
  end;
end;


constructor TCoco.Create(AOwner: TComponent);
begin
  
  inherited;

  if Length(CocoSymSets)=0 then
  InitSymSets(CocoSymSets,[
    	{ 0} _EOFSYMB, identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _equalSym, _lparen_pointSym, -1,
	{ 1} CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, -1,
	{ 2} _EOFSYMB, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, -1,
	{ 3} identSym, stringSym, _lparenSym, _lbrackSym, _lbraceSym, -1,
	{ 4} identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _lparen_pointSym, -1,
	{ 5} _EOFSYMB, identSym, stringSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, ANYSym, _lparenSym, _barSym, _lbrackSym, _lbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{ 6} _EOFSYMB, identSym, stringSym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _equalSym, _lparen_pointSym, -1,
	{ 7} CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _rparenSym, _rbrackSym, _rbraceSym, TOSym, NESTEDSym, -1,
	{ 8} identSym, stringSym, badstringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _greaterSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{ 9} identSym, stringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _greaterSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{10} identSym, stringSym, badstringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _lparen_pointSym, _point_rparenSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{11} identSym, stringSym, numberSym, COMPILERSym, FRAMESym, ENDSym, CHARACTERSSym, TOKENSSym, HOMOGRAPHSSym, PRAGMASSym, COMMENTSSym, IGNORECASESym, IGNORESym, PRODUCTIONSSym, _pointSym, _equalSym, _plusSym, _minusSym, _point_pointSym, ANYSym, CHRSym, _lparenSym, _rparenSym, HOMOGRAPHSym, _barSym, CONTEXTSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, FROMSym, TOSym, NESTEDSym, _lessSym, _lparen_pointSym, _point_rparenSym, IFSym, WEAKSym, SYNCSym, _NOSYMB, -1,
	{12} identSym, stringSym, _pointSym, ANYSym, _lparenSym, _rparenSym, _barSym, _lbrackSym, _rbrackSym, _lbraceSym, _rbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{13} _pointSym, _rparenSym, _rbrackSym, _rbraceSym, -1,
	{14} identSym, stringSym, ANYSym, _lparenSym, _lbrackSym, _lbraceSym, _lparen_pointSym, IFSym, WEAKSym, SYNCSym, -1,
	{15} identSym, stringSym, ANYSym, _lparenSym, _lbrackSym, _lbraceSym, _lparen_pointSym, WEAKSym, SYNCSym, -1,
	{16} _pointSym, _rparenSym, _barSym, _rbrackSym, _rbraceSym
  ]); 
  SymSets := CocoSymSets;
  
end;

end.

